          SUBROUTINE (INIT.OID,GEN,PRT.ON,SHP.STATS,PRT.OPT,PRT.TGS,CMTD)
** Version# 19.0112 - 09/16/2010 - 01:48pm - HEGDAV - eclipse
*** V19.0112 Change - Custom Coding .. - 09/16/2010 - HEGDAV - eclipse
*** V19.0111 Change - Custom Coding . - 09/15/2010 - SMITJR - eclipse
*** V19.011 Change - Custom Coding .. - 09/08/2010 - HEGDAV - eclipse
** Copied from CBP DEF.RECEIVER.TEST Version# 19.0109[37] - 07/14/2010 - 02:39pm - SMITJR - eclipse
** Copied from CBP POE.PRINT.RECVR Version# 62.0002[3] - 06/07/2010 - 01:36pm - SMITJR - eclipse
** Copied from CBP DEF.RECEIVER.TEST Version# 19.0109[10] - 06/07/2010 - 01:22pm - SMITJR - eclipse
*** V62.0002 Change - Custom Coding CUSTOM - 07/14/2010 - SMITJR - eclipse
*** V19.0109 Change - Custom Coding . - 08/26/2010 - SMITJR - eclipse
** Copied from BP DEF.RECEIVER.TEST Version# 19.0106 - 11/20/2008 - 03:33pm - ROYO - eclipse
*** V19.0106 Change - Custom Coding FORMS.MOD - 11/20/2008 - ROYO - eclipse
** Copied from UBP POE.PRINT.RECVR Version# 19.0105 - 01/24/2008 - 04:04pm - BILLB - eclipse
*** V19.0105 Change - Custom Coding CVR422 - 01/24/2008 - BILLB - eclipse
** Copied from UBP POE.PRINT.RECVR.ECL Version# 19.0104[5] - 01/23/2008 - 04:06pm - BILLB - eclipse
*** V19.0104 Change - Temporary Debugging Only CVR422 - 01/23/2008 - BILLB - eclipse
** Copied from UBP POE.PRINT.RECVR Version# 19.0103 - 10/16/2007 - 03:44pm - HEATHERY - eclipse
*** V19.0103 Change - Custom Coding HDB282 - 10/16/2007 - HEATHERY - UPGRADE
*** V19.0102 Change - Custom Coding DEC478 - 08/18/2003 - JOHNG - eclipse
*** V19.0102 Change - Custom Coding DEC478 - 11/21/2002 - JOHNG - eclipse
*** V19.0101 Change - Custom Coding BCL412 - 08/07/2002 - JONW - UPGRADE
*** V19.01 - 05/03/1999 - 12:26pm - NELSONC - eclipse
*** Subroutine - POE.PRINT.RECVR
*-------------------------------------------------------------------------*
*** This routine prints a Purchase Order Receiver Report, which is used as
*** a working receiving document when a shipment arrives at the receiving
*** dock. The report helps the warehouse person receiving material from a
*** purchase order to take the appropriate action. If there are open sales
*** orders waiting for the receipt of this purchase order, then there may
*** be no need to put the material on the shelf.
*-------------------------------------------------------------------------*
*** INIT.OID   - Purchase Order Id                                    [In]
*** GEN        - Generation                                           [In]
*** PRT.ON     - Null                                                 [In]
*** SHP.STATS  - Order Status                                         [In]
*** PRT.OPT    - All, NonStock Only, Stock Only                       [In]
*** PRT.TGS    - Show tagged quantities  :  Only this Order,
***              All Orders                                           [In]
*** CMTD       - All or Order Quantity (Committed)                    [In]
*-------------------------------------------------------------------------*
*** Common: LED, LD, CUSS, PRD, PHANTOM.PROC
*-------------------------------------------------------------------------*

          IF NOT(PHANTOM.PROC) AND NOT(PRT.ON) AND NOT(JAVA.PROC$) THEN
             OPEN.WINDOW = YES
          END ELSE
             OPEN.WINDOW = NO
          END

          SERIAL  = NO
          PG.LGTH = 60
          OID = INIT.OID

          IF OPEN.WINDOW THEN
             WINDOW 15,8,50,5
             PRINT @(0,1):'Printing .... ':OID
          END

          MATREAD LED FROM LEDFILE,OID ELSE GOTO FINISH

          CONVERT ',' TO VM IN SHP.STATS

          OE.GET.QSIGN QSIGN,OID,GEN
          BR     = LED(2)<1,GEN,1>
          STK.BR = LED(2)<1,GEN,2>
          BT.CN  = LED(1)<1,GEN>
          ST.CN  = LED(5)<1,GEN>
          GET.CUS BR,BT.CN,ST.CN,QSIGN
          BEGIN CASE
          CASE OID[1,1]='T';   LDIDS = LED(48)<1,1>
          CASE LED(8)<1,GEN>=''
             LDIDS = LED(49)
             CONVERT VM TO SVM IN LDIDS
          CASE OTHERWISE
             LDIDS = LED(48)<1,GEN>
          END CASE

          GOSUB INIT
          IF NOT(PRT.ON) THEN
             PRINTER.ON "PURCH.RECVR"
          END

          GOSUB HEADER

          LDID.CT = DCOUNT(LDIDS,SVM)
          FOR LD.NO = 1 TO LDID.CT
             LDID   = LDIDS<1,1,LD.NO>
             GOSUB PRT.LINE

          NEXT LD.NO


          GOSUB FOOTER

          IF SERIAL THEN
             POE.SERIAL.WKSHT INIT.OID,GEN
          END

          IF NOT(PRT.ON) THEN
             PRINTER.OFF
          END

          GOTO FINISH
*-------------------------------------------------------------------------*
INIT:     *
          PAGE       = 0
          IN.FOOTER  = NO
          PG.LGTH    = 60

          INVN   = LED(8)<1,GEN>
          IF INVN='' THEN
             ORD.ID = OID
          END ELSE
             ORD.ID = OID:'.':INVN"R%3"
          END

          RETURN
*-------------------------------------------------------------------------*
HEADER:   *
          PAGE     = PAGE + 1
          LINE.CT  = PG.LGTH
          IF PRT.OPT[1,1] = 'A' THEN OPT.MSG='' ELSE OPT.MSG="   ":PRT.OPT
*         IF LED(69)<1,GEN,1> THEN FRT.ALLOW = 'YES' ELSE FRT.ALLOW = 'NO'
          IF LED(69)<1,GEN,1> THEN FRT.ALLOW = LED(69)<1,GEN,1>

          IF ORD.ID[1,1]='T' THEN
             PRINT SPACE(20):'*** T r a n s f e r   R e c e i v e r ***':
             WRK = 'Xfr'
          END ELSE
             PRINT SPACE(25):'*** P / O   R e c e i v e r ***':
             WRK = 'P/O'
          END
          PRINT OPT.MSG
          PRINT WRK:' #  : ':ORD.ID"L#12":SPACE(45):'Page : ':PAGE"R#3"
          PRINT
*B2B
          VADDR = LED(78)<1,GEN,6>
          IF NOT(VADDR) THEN VADDR = CUSS(1)
          PRINT 'Vendor : ':VADDR<1>"L#55":'Branch : ':STK.BR
          PRINT
          PRINT 'Writer : ':LED(73)<1,GEN>"L#10":'   Receiver : _______________    Recv Date : __________'
          PRINT 'Printed By : ':SECURITY<3>

          PRINT 'Freight Allowed: ':FRT.ALLOW"L#25"
          PRINT 'Location ':WRK:' Qty  Ship Qty        Description / Committed Orders            Bin'
          PRINT '-------- -------  --------  ---------------------------------------------- -----'

          LINE.CT -= 11

          RETURN
*-------------------------------------------------------------------------*
FOOTER:   *
          GOSUB BARCODE
          IN.FOOTER = YES

          PRINT CHAR(12):

          LINE.CT = 0

          RETURN
*-------------------------------------------------------------------------*
PRT.LINE: *
          LD.GET LDID

          PN = LD(1)
          IF NOT(NUM(PN)) THEN RETURN

          GET.ALL.PRD BR,PN,QSIGN,GROUP
          * release 8 start
          * GET.PRDD.BR STK.BR,PN
          * release 8 end
          STAT = PRD(3)

          * release 8 start
          PRD.BR.GET.VAL STK.BR,PN,25,SERIAL.TRACKING
          IF SERIAL.TRACKING ='I' OR SERIAL.TRACKING ='A' OR SERIAL.TRACKING='D' THEN

          * IF PRD(74)<1,STK.BR>='I' OR PRD(74)<1,STK.BR>='A' OR PRD(74)<1,STK.BR>='D' THEN
          * release 8 end
             SERIAL = YES
          END
          BEGIN CASE
          CASE STAT=1;    STAT = 'S'
          CASE STAT=2;    STAT = 'N'
          CASE STAT=3;    STAT = 'M'
          CASE STAT=4;    STAT = 'D'
          CASE STAT=5;    STAT = 'R'
          CASE STAT=6;    STAT = 'C'
          END CASE
          OE.DESC.GET DESC,'',"POE Printing"
          KEYW = PRD(4)<1,1>
          CODE = FIELD(KEYW," ",2)
*----Kits
          IF LD(31)#'' AND PRD(86)<1,2> = '1' THEN
             KCMPS = LD(31)
             KQTYS = LD(30)
             GET.KIT.COMPS KCMPS,KQTYS,35,DESC
          END

    *     RETURN
*-------------------------------------------------------------------------*
PRT.PN:   *
          TQTY = (SUM(LD(5)<1,GEN>) + SUM(LD(6)<1,GEN>)) * QSIGN
          IF TQTY   = 0 THEN GOTO NO.PTR
          TQTYS = ADDS(LD(5)<1,GEN>,LD(6)<1,GEN>)
          TQ.CNT = DCOUNT(TQTYS,SVM)
          FOR TQ = 1 TO TQ.CNT
          TQNT   = TQTYS<1,1,TQ>
          SHP.TYP.LOC = LD(7)<1,GEN,TQ>
          LOCA    = FIELD(FIELD(SHP.TYP.LOC,'~',2),'^',1)
          IF LOCA='' THEN
             PRD.LOCATION.GET PRI.LOC,PN,STK.BR
             LOCA = PRI.LOC
          END
          TAG = FIELD(LOCA,'^',2)
          IF TAG # '' THEN LOCA = FIELD(TAG,".",1)
          GOSUB PRT.PO
          NEXT TQ

          BEGIN CASE
          CASE PRT.OPT[1,1]='S' AND STAT # 'S'; GOTO SKIPPRT
          CASE PRT.OPT[1,1]='N' AND STAT = 'S'; GOTO SKIPPRT
          END CASE
      * Print All tag Qtys first
          TYP.LOCS = LD(7)<1,GEN>
          LOC.CT   = DCOUNT(TYP.LOCS,SVM)
          TAG.FLAG = YES
          FOR LOC  = 1 TO LOC.CT
          TYPE = FIELD(TYP.LOCS<1,1,LOC>,'~',1)
          IF TYPE = 'T' THEN
             TAG     = TYP.LOCS<1,1,LOC>
             ORN     = FIELD(TAG,'^',2)
             OID     = FIELD(ORN,'.',1)
             LDID    = FIELD(ORN,'.',2)+0
             GID     = ''
             TYPE    = ''
             TORN    = ''
             CTAG    = 'Tagged'
             SHP.QTY = LD(6)<1,GEN,LOC>
             SBR     = STK.BR
             GOSUB PRT.QTY

             TQTY   -= SHP.QTY
          END
          NEXT LOC
          TAG.FLAG = NO

      *** Print Stock committments until P/O Qty is used up
          GOSUB SET.PRIS

          *** If the control record to exclude all sales orders
          *** outside the plenty date is set to yes, then prioritize
          *** our orders by ship date and first in first out.
          GOSUB GET.PRI

          ID.CT = DCOUNT(IDS,AM)
          FOR J = 1 TO ID.CT
             IF TQTY <= 0 AND CMTD THEN EXIT
             SHP.QTY  = -QTYS<J>+0
             ID       = IDS<J>
             SBR      = SBRS<J>

             *** Make sure to setup a correct branch.
             IF SBR   = '' THEN SBR = WHSE

             *** Only show Tagged Orders on the P/O recvr...
             IF SBR # STK.BR AND WRK = 'Xfr' THEN GOTO NEXTJ

               IF SHP.QTY > 0 AND FIELD(ID,'~',6) # 'D' THEN
                OID   = FIELD(ID,'~',3)
                GID   = FIELD(ID,'~',5)
                TYPE  = FIELD(ID,'~',6)
                TORN  = FIELD(ID,'~',7)
                LDID  = ''
                CTAG  = ''

             *** Don't print the tagged qtys if they ask not to.
                IF TYPE = 'T' AND NOT(PRT.TGS) THEN GOTO NEXTJ

             GOSUB PRT.QTY
             TQTY -= SHP.QTY
          END
NEXTJ:    NEXT J

          GOSUB PRT.XFER
          PRINT STR('-',80)
          LINE.CT -= 1

SKIPPRT:  GOSUB SUBT.ONE
          PRINT

NO.PTR:   RETURN
*-------------------------------------------------------------------------*
SET.PRIS: * Set the priorities correclty for a mom branch
           GET.PCGID PCGID,PRD(18),PRD(12)
           OE.GET.PRIS IDS,QTYS,SBRS,WHSE,PN,STK.BR,PCGID

          RETURN
*-------------------------------------------------------------------------*
PRT.XFER: *
          ITEM.XFER.GET INFO,PN,STK.BR
          CT = DCOUNT(INFO<1>,VM)
          FOR J = 1 TO CT
          IF INFO<2,J> THEN
             GOSUB SUBT.ONE
             PRINT ''                                          "L#17":
             PRINT '** Branch Transfer to BR# : ':INFO<1,J>    "L#5":
             PRINT ' - Qty :':INFO<2,J>                        "L#7"
          END
          NEXT J
          RETURN
*-------------------------------------------------------------------------*
PRT.PO:   *
          GOSUB SUBT.ONE
          PRINT CODE        "L#9":
          PRINT TQNT        "R#7":
          PRINT ' |     |'  "L#9":
          PRINT DESC<1,1>   "L#45":
          PRINT STAT        "L#1":'|':
          PRINT LOCA       "L#7"
          DESC = DELETE(DESC,1,1)
          GOSUB PRT.XDESC
          RETURN
*-------------------------------------------------------------------------*
PRT.QTY:  *
          READV LED5  FROM LEDFILE,OID,5               ELSE LED5  = ''
          READV LED6  FROM LEDFILE,OID,6               ELSE LED6  = ''
          READV LED9  FROM LEDFILE,OID,9               ELSE LED9  = ''
          IF NOT(LDID) THEN
             READV LED12 FROM LEDFILE,OID,12           ELSE LED12 = ''
             LOCATE GID IN LED12<1> SETTING OGN ELSE OGN   = 1
          END ELSE
             READV LED8 FROM LEDFILE,OID,8             ELSE LED8  = ''
             LD.READV LD7, OID, LDID, 7
             GCT = DCOUNT(LED6,VM)
             FOR OGN = 1 TO GCT
                IF NOT(LED8<1,OGN>) AND INDEX(LD7<1,OGN>,'T~',1) THEN EXIT
             NEXT OGN
          END
          READV CNAME FROM CUSFILE,LED5<1,OGN>,1       ELSE CNAME = ''
          IF SHP.STATS#'' THEN
             LOCATE LED6<1,OGN> IN SHP.STATS<1> SETTING POS ELSE RETURN
          END
  *** Pull the UoM that was used on the order for our product...
          LD.READV LD23,OID,LDID,23
          IQ.TO.ALPHA PLNE(3),PRD(7),LD23,SHP.QTY,,,,,QO.ALPHA
          TYPE = FIELD(TYP.LOCS<1,1,LOC>,'~',1)
          IF LOCA='' OR STAT='N' OR TYPE='T' THEN
          GOSUB SUBT.ONE
          LINE  = SPACE(25)
          IF ORD.ID[1,1] = 'T' THEN LINE := SPACE(2)
          LINE := TRIM(QO.ALPHA)           "L#9 "
          LINE := OID                      "L#13 "
          LINE := OCONV(LED9<1,OGN>,'D2/') "L#11"
          PRINT LINE

          GOSUB SUBT.ONE
          LINE  = SPACE(25)
          IF ORD.ID[1,1] = 'T' THEN LINE := SPACE(2)
          LINE := CTAG                     "L#6 "
          LINE := LED6<1,OGN>              "L#3 "
          LINE := CNAME                    "L#33"
          PRINT LINE
          END ELSE
          END

          IF TYPE = 'T' THEN
             GOSUB SUBT.ONE

             LINE  = SPACE(25):'** Above is Tagged to : '
             LINE := FIELD(TORN,'^',2) "L#8"
             LINE := ' **'
             PRINT LINE

          END ELSE IF SBR # STK.BR THEN
             GOSUB SUBT.ONE

             LINE  = SPACE(25):'** Branch Transfer to BR# : ':SBR "L#5 "
             LINE := 'Order : ':OID
             PRINT LINE
          END

          RETURN
*-------------------------------------------------------------------------*
PRT.XDESC: *
          DESC.CT = DCOUNT(DESC,VM)
          FOR DLN = 1 TO DESC.CT
             GOSUB SUBT.ONE
             PRINT '' "L#17":
             PRINT '|     | ':SPACE(1):
             PRINT DESC<1,DLN>          "L#45":
             PRINT '|'
          NEXT DLN
          RETURN
*-------------------------------------------------------------------------*
BARCODE:  PRINT CHAR(27):"*p1750x*p3175Y":
          UT.PRINT.BARCODE ERR.CODE,'CODE128',150,5,7,ORD.ID
          *PRINT CHAR(12):
          RETURN
*-------------------------------------------------------------------------*
SUBT.ONE: *
          IF LINE.CT < 5 THEN
             GOSUB FOOTER
             GOSUB HEADER
          END
          LINE.CT -= 1
          RETURN
*-------------------------------------------------------------------------*
*-------------------------------------------------------------------------*
GET.PRI: *** Determine whether the committed orders fall within the
         *** plenty date range or not.  Then place in order based on the
         *** order date.

*** Initialize the variables.
          PY.IDS   = ''
          PY.QTYS  = ''
          PY.BRS   = ''
          IDS.TMP  = IDS
          QTYS.TMP = QTYS
          SBRS.TMP  = SBRS
          IDS      = ''
          QTYS     = ''
          SBRS     = ''

          PLENTY.DATE = DATE.NEXT.REC(PN,BR)


*** Loop through all of the ids and put them in order of priority.
          MORE.DATA = (IDS.TMP # '')
          LOOP UNTIL NOT(MORE.DATA)

             REMOVE ID   FROM IDS.TMP  SETTING MORE.DATA
             REMOVE QTY  FROM QTYS.TMP SETTING X
             REMOVE SBR  FROM SBRS.TMP SETTING Y
             IF SBR = '' THEN SBR = WHSE

             IF QTY < 0 THEN
                SHP.DT   = FIELD(ID,'~',2)+0
                ORD.STAT = FIELD(ID,'~',9)
                THIS.OID = FIELD(ID,'~',3)

                *** Check the order stat and adjust to the correct dt
                STAT.OK = ORD.STAT#'W' AND ORD.STAT#'S' AND ORD.STAT#'D'

                *** Only want to exclude the Plenty Date if the Product is
                *** not a Delete Status Product
                READV PRD.STAT FROM PRDFILE,PN,3 ELSE PRD.STAT = ""
                IF PRD.STAT # "4" THEN
                   IF EXC.FUT.SOE$ THEN STAT.OK = NO
                END

                BEGIN CASE
                CASE THIS.OID[1,1]='S' AND STAT.OK
                   IF SBR # BR AND BR # WHSE THEN
                      SHP.DT = PLENTY.DATE
                   END ELSE
                      SHP.DT = DATE()
                   END
                CASE THIS.OID[1,1]='S' AND NOT(STAT.OK) AND ORD.STAT#'D'
                   SHP.DT = SHP.DT
                   IF SBR # BR AND BR # WHSE THEN
                      IF SHP.DT < PLENTY.DATE THEN SHP.DT = PLENTY.DATE
                   END
                CASE QTY < 0 AND SBR # BR AND BR # WHSE
                   IF SHP.DT < PLENTY.DATE THEN SHP.DT = PLENTY.DATE
                END CASE

                IF SHP.DT >= PLENTY.DATE THEN
                   PY.IDS<-1>  = ID
                   PY.QTYS<-1> = QTY
                   PY.BRS<-1>  = SBR
                END ELSE
                   IDS<-1>  = ID
                   QTYS<-1> = QTY
                   SBRS<-1> = SBR
                END
             END
          REPEAT

*** Add in the later ids. (Past the plenty date)
          IF PY.IDS # '' THEN
             IDS<-1>  = PY.IDS
             QTYS<-1> = PY.QTYS
             SBRS<-1> = PY.BRS
          END

          RETURN
*-------------------------------------------------------------------------*
FINISH:   ***  If not Phantom or printing, close the window.
          IF OPEN.WINDOW THEN
             WINDOW.CLOSE
          END
          RETURN
!HEGDAV~09/16/10~13:48
